home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic Source Code
/
Visual Basic Source Code.iso
/
vbsource
/
vbpcopy
/
jmscreen.bas
< prev
next >
Wrap
BASIC Source File
|
1998-10-03
|
7KB
|
269 lines
Attribute VB_Name = "JMScreenSubs"
Option Explicit
'
' Scructure Definitions
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Type APPBARDATA
cbSize As Long
hWnd As Long
uCallbackMessage As Long
uEdge As Long
rc As RECT
lParam As Long
End Type
'
' Definitions
Declare Function SHAppBarMessage Lib "shell32.dll" (ByVal dwMessage As Long, pData As APPBARDATA) As Long
Global Const ABS_ALWAYSONTOP = &H2
Global Const ABS_AUTOHIDE = &H1
Global Const ABM_GETSTATE = &H4
Global Const ABM_GETTASKBARPOS = &H5
Public Function JMTaskbarExists() As Integer
Dim wrkBar As APPBARDATA
On Error Resume Next
'
' Set Size of Structure
wrkBar.cbSize = 36
'
' Get Status of Taskbar
Select Case SHAppBarMessage(ABM_GETSTATE, wrkBar)
Case ABS_ALWAYSONTOP, ABS_AUTOHIDE
'
' Taskbar exists
JMTaskbarExists = True
Exit Function
End Select
'
' Taskbar does not
JMTaskbarExists = False
End Function
Public Function JMScreenHeight() As Long
Dim wrkBar As APPBARDATA
Dim wrkHeight As Long
Dim wrkTop As Long
Dim wrkBottom As Long
On Error GoTo JMScreenHeightError
'
' Set Default Height
JMScreenHeight = Screen.Height
' JMScreenHeight = 480 * Screen.TwipsPerPixelY
' Exit Function
'
' Test for a Taskbar
If (JMTaskbarExists() = False) Then Exit Function
'
' Set Size of Structure
wrkBar.cbSize = 36
'
' Get Size and Position of Taskbar
wrkHeight = Screen.Height / Screen.TwipsPerPixelY
If (SHAppBarMessage(ABM_GETTASKBARPOS, wrkBar) = False) Then Exit Function
'
' Extract Top and Bottom
wrkTop = wrkBar.rc.Top
wrkBottom = wrkBar.rc.Bottom
'
' Set if Bar is Vertical
If (wrkTop <= 0 And wrkBottom >= wrkHeight) Then
wrkHeight = Screen.Height
'
' Set if Bar is at Top
ElseIf (wrkTop < 0) Then
wrkHeight = (wrkHeight - wrkBottom) * Screen.TwipsPerPixelY
'
' Set if Bar is at Bottom
ElseIf (wrkBottom >= wrkHeight) Then
wrkHeight = wrkTop * Screen.TwipsPerPixelY
'
' Set if Anywhere Else (Shouldn't be!)
Else
wrkHeight = Screen.Height
End If
'
' Set Height
JMScreenHeight = wrkHeight
Exit Function
'
' Error
JMScreenHeightError:
JMScreenHeight = Screen.Height
Exit Function
End Function
Public Function JMScreenWidth() As Long
Dim wrkBar As APPBARDATA
Dim wrkWidth As Long
Dim wrkLeft As Long
Dim wrkRight As Long
On Error GoTo JMScreenWidthError
'
' Set Default Width
JMScreenWidth = Screen.Width
' JMScreenWidth = 640 * Screen.TwipsPerPixelX
' Exit Function
'
' Test for a Taskbar
If (JMTaskbarExists() = False) Then Exit Function
'
' Set Size of Structure
wrkBar.cbSize = 36
'
' Get Size and Position of Taskbar
wrkWidth = Screen.Width / Screen.TwipsPerPixelX
If (SHAppBarMessage(ABM_GETTASKBARPOS, wrkBar) = False) Then Exit Function
'
' Extract Left and Right
wrkLeft = wrkBar.rc.Left
wrkRight = wrkBar.rc.Right
'
' Set if Bar is Horizontal
If (wrkLeft <= 0 And wrkRight >= wrkWidth) Then
wrkWidth = Screen.Width
'
' Set if Bar is at Left
ElseIf (wrkLeft < 0) Then
wrkWidth = (wrkWidth - wrkRight) * Screen.TwipsPerPixelX
'
' Set if Bar is at Right
ElseIf (wrkRight >= wrkWidth) Then
wrkWidth = wrkLeft * Screen.TwipsPerPixelY
'
' Set if Anywhere Else (Shouldn't be!)
Else
wrkWidth = Screen.Width
End If
'
' Set Width
JMScreenWidth = wrkWidth
Exit Function
'
' Error
JMScreenWidthError:
JMScreenWidth = Screen.Width
Exit Function
End Function
Public Function JMScreenTop() As Long
Dim wrkBar As APPBARDATA
Dim wrkScreenTop As Long
Dim wrkHeight As Long
Dim wrkTop As Long
Dim wrkBottom As Long
On Error GoTo JMScreenTopError
'
' Set Default Top
JMScreenTop = 0
'
' Test for a Taskbar
If (JMTaskbarExists() = False) Then Exit Function
'
' Set Size of Structure
wrkBar.cbSize = 36
'
' Get Size and Position of Taskbar
If (SHAppBarMessage(ABM_GETTASKBARPOS, wrkBar) = False) Then Exit Function
'
' Extract Top and Bottom
wrkTop = wrkBar.rc.Top
wrkBottom = wrkBar.rc.Bottom
'
' Set Screen Height
wrkHeight = Screen.Height / Screen.TwipsPerPixelY
'
' Set if Bar is at Top
If (wrkTop < 0 And wrkBottom < wrkHeight) Then
wrkScreenTop = wrkBottom * Screen.TwipsPerPixelY
'
' Set if Anywhere Else
Else
wrkScreenTop = 0
End If
'
' Set Top
JMScreenTop = wrkScreenTop
Exit Function
'
' Error
JMScreenTopError:
JMScreenTop = 0
Exit Function
End Function
Public Function JMScreenLeft() As Long
Dim wrkBar As APPBARDATA
Dim wrkScreenLeft As Long
Dim wrkWidth As Long
Dim wrkLeft As Long
Dim wrkRight As Long
On Error GoTo JMScreenLeftError
'
' Set Default Top
JMScreenLeft = 0
'
' Test for a Taskbar
If (JMTaskbarExists() = False) Then Exit Function
'
' Set Size of Structure
wrkBar.cbSize = 36
'
' Get Size and Position of Taskbar
If (SHAppBarMessage(ABM_GETTASKBARPOS, wrkBar) = False) Then Exit Function
'
' Extract Left and Right
wrkLeft = wrkBar.rc.Left
wrkRight = wrkBar.rc.Right
'
' Set Screen Height
wrkWidth = Screen.Width / Screen.TwipsPerPixelX
'
' Set if Bar is at Left
If (wrkLeft < 0 And wrkRight < wrkWidth) Then
wrkScreenLeft = wrkRight * Screen.TwipsPerPixelX
'
' Set if Anywhere Else
Else
wrkScreenLeft = 0
End If
'
' Set Left
JMScreenLeft = wrkScreenLeft
Exit Function
'
' Error
JMScreenLeftError:
JMScreenLeft = 0
Exit Function
End Function
Public Sub SetFormPosition(frmSetup As Form, argTop As Long, argLeft As Long)
On Error Resume Next
'
' Position Form
frmSetup.Left = argLeft
frmSetup.Top = argTop
'
' Check not too far right
If ((frmSetup.Left + frmSetup.Width) > (JMScreenLeft() + JMScreenWidth())) Then
frmSetup.Left = JMScreenLeft() + JMScreenWidth() - frmSetup.Width
End If
'
' Check not too far down
If ((frmSetup.Top + frmSetup.Height) > (JMScreenTop() + JMScreenHeight())) Then
frmSetup.Top = JMScreenTop() + JMScreenHeight() - frmSetup.Height
End If
'
' Check not too far left
If (frmSetup.Left < JMScreenLeft()) Then frmSetup.Left = JMScreenLeft()
'
' Check not too far up
If (frmSetup.Top < JMScreenTop()) Then frmSetup.Top = JMScreenTop()
End Sub